Otherware/Otherware_1_SB_Development.iso/mac/misc/update/tpasc302.cpt/TCL Update/New ArtClass Files/CArtClassApp.p

Text File | 1990-05-11 | 9.3 KB | 384 lines

{****************************************************}
{         CArtClassApp.p}
{}
{        The ArtClass Application Class}
{}
{        SUPERCLASS = CApplication}
{}
{        Copyright ⌐ 1989, Symantec Corporation.  All rights reserved.            }
{}
{        written by:                     Gregory H. Dow}
{        ported from THINK C by:        Greg Howe}
{}
{****************************************************}

unit CArtClassApp;

interface

    uses
        TCL, MoreTCL, ArtClassIntf;

implementation


{****************************************************}
{ IArtClassApp}
{}
{        Initialize the ArtClass Application}
{}
{****************************************************}

    procedure CArtClassApp.IArtClassApp;
        var
            itemStr: Str255;

    begin
        theAboutBox := nil;
        gPaintTool := toolPENCIL;

        IApplication(4, 60000, 3072);    { Initialize superclass            }

                                        { Global variable for an offscreen    }
                                        {   BitMap with its own port            }
        new(gScratchPad);
        gScratchPad.IBitMap(PNTG_WIDTH, PNTG_HEIGHT, TRUE);

        itsPatsDir.GetPattern(gPattern);
        gLineSize := 1;

        gShapeCurs := GetCursor(CURSshape);
        gPencilCurs := GetCursor(CURSpencil);
        gEraserCurs := GetCursor(CURSeraser);
        gBrushCurs := GetCursor(CURSbrush);
        gDragCurs := GetCursor(CURSdrag);
        gSelectCurs := GetCursor(CURSselect);

        gFontNum := applFont;
        gFontSize := SYS_FONT_SIZE;
        gFontStyle := [];
        gLineSpacing := cmdSingleSpace;

        GetFontName(gFontNum, itemStr);
        gFontItem := gBartender.FindItemText(MENUfont, itemStr);

        NumToString(gFontSize, itemStr);
        gSizeItem := gBartender.FindItemText(MENUsize, itemStr);
    end;


{****************************************************}
{ MakeDesktop (OVERRIDE)}
{}
{        Use the Desktop subclass which supports floating windows}
{}
{****************************************************}

    procedure CArtClassApp.MakeDesktop;
    begin
        new(CFWDesktop(gDesktop));
        CFWDesktop(gDesktop).IFWDesktop(SELF);
    end;


{****************************************************}
{ SetUpFileParameters (OVERRIDE)}
{}
{        Set parameters used by the Standard File Package}
{}
{****************************************************}

    procedure CArtClassApp.SetUpFileParameters;
    begin
        inherited SetUpFileParameters;    { Use defaults from superclass        }

        gSignature := 'Artì';                    { Signature for our application        }

        sfNumTypes := 1;
        sfFileTypes[0] := 'PNTG';            { ArtClass can read paintings        }
    end;


{****************************************************}
{ SetUpMenus (OVERRIDE)}
{}
{        Set up the menus used by the Art Class Application}
{}
{****************************************************}

    procedure CArtClassApp.SetUpMenus;
        var
            macMenu: MenuHandle;
            theToolsDir: CToolsDir;
            thePatsDir: CPatternsDir;   { Altered by TCL Weaver 1.0 (5/9/90) }

    begin
        new(theToolsDir);               { Director for a tear-off tool  menu }
        itsToolsDir := theToolsDir;     { Altered by TCL Weaver 1.0 (5/9/90) }
        itsToolsDir.IToolsDir(SELF);

        new(thePatsDir);                    { Tear-off Patterns menu        }
        itsPatsDir := thePatsDir;           { Altered by TCL Weaver 1.0 (5/9/90) }
        itsPatsDir.IPatternsDir(SELF);

        new(CBarOwner(gBartender));                { Use our own Bartender subclass    }
        CBarOwner(gBartender).IBarOwner(MBARapp);

        AddResMenu(GetMHandle(MENUapple), 'DRVR');        { Apple Menu    }
        gBartender.SetDimOption(MENUapple, dimNONE);

        AddResMenu(GetMHandle(MENUfont), 'FONT');

                                        { No individual items are ever    }
                                        {   dimmed in these menus. It's    }
                                        {   all or nothing                    }

        gBartender.SetDimOption(MENUtools, dimNONE);
        gBartender.SetDimOption(MENUpatterns, dimNONE);
        gBartender.SetDimOption(MENUlines, dimNONE);
        gBartender.SetDimOption(MENUtext, dimNONE);
        gBartender.SetDimOption(MENUfont, dimNONE);
        gBartender.SetDimOption(MENUsize, dimNONE);

                                        { These menus have check marked    }
                                        {   items                                }

        gBartender.SetUnchecking(MENUlines, TRUE);
        gBartender.SetUnchecking(MENUtext, TRUE);
        gBartender.SetUnchecking(MENUfont, TRUE);
        gBartender.SetUnchecking(MENUsize, TRUE);
    end;


{****************************************************}
{ DoCommand (OVERRIDE)}
{}
{        Execute a command}
{}
{****************************************************}

    procedure CArtClassApp.DoCommand (theCommand: longint);
        var
            itemName: Str255;
            number: longint;
            aStyle: Style;
            anAboutBox: CAboutBox;      { Altered by TCL Weaver 1.0 (5/9/90) }

    begin
        if theCommand < 0 then
            begin
                case HiWord(-theCommand) of

                    MENUtools:
                        begin
                            gPaintTool := PaintTools(LoWord(-theCommand));
                            itsToolsDir.SelectTool(integer(gPaintTool));
                        end;

                    MENUpatterns:
                        begin
                            itsPatsDir.SelectPattern(LoWord(-theCommand));
                            itsPatsDir.GetPattern(gPattern);
                        end;

                    MENUfont:
                        begin
                            gBartender.GetCmdText(theCommand, itemName);
                            gFontItem := LoWord(-theCommand);
                            GetFontNumber(itemName, gFontNum);
                        end;

                    MENUsize:
                        begin
                            gBartender.GetCmdText(theCommand, itemName);
                            StringToNum(itemName, number);
                            gSizeItem := LoWord(-theCommand);
                            gFontSize := number;
                        end;

                    otherwise
                        inherited DoCommand(theCommand);
                end;
            end

        else
            begin
                case theCommand of

                    cmdAbout:
                        begin
                            new(anAboutBox);                { Altered by TCL Weaver 1.0 (5/9/90) }
                            theAboutBox := anAboutBox;
                            theAboutBox.IAboutBox(SELF);
                            theAboutBox.Free;
                            theAboutBox := nil;
                            FlushEvents(mDownMask + mUpMask + keyDownMask + keyUpMask + autoKeyMask, 0);
                        end;

                    cmdLineNone, cmdLineOne, cmdLineTwo, cmdLineThree, cmdLineFour:
                        gLineSize := theCommand - cmdLineNone;

                    cmdPlain:
                        gFontStyle := [];

                    cmdBold:
                        if bold in gFontStyle then
                            gFontStyle := gFontStyle - [bold]
                        else
                            gFontStyle := gFontStyle + [bold];

                    cmdItalic:
                        if italic in gFontStyle then
                            gFontStyle := gFontStyle - [italic]
                        else
                            gFontStyle := gFontStyle + [italic];

                    cmdUnderline:
                        if underline in gFontStyle then
                            gFontStyle := gFontStyle - [underline]
                        else
                            gFontStyle := gFontStyle + [underline];

                    cmdOutline:
                        if outline in gFontStyle then
                            gFontStyle := gFontStyle - [outline]
                        else
                            gFontStyle := gFontStyle + [outline];

                    cmdShadow:
                        if shadow in gFontStyle then
                            gFontStyle := gFontStyle - [shadow]
                        else
                            gFontStyle := gFontStyle + [shadow];

                    cmdCondense:
                        if condense in gFontStyle then
                            gFontStyle := gFontStyle - [condense]
                        else
                            gFontStyle := gFontStyle + [condense];

                    cmdExtend:
                        if extend in gFontStyle then
                            gFontStyle := gFontStyle - [extend]
                        else
                            gFontStyle := gFontStyle + [extend];

                    cmdSingleSpace, cmd1HalfSpace, cmdDoubleSpace:
                        gLineSpacing := theCommand;

                    otherwise
                        inherited DoCommand(theCommand);
                end;
            end;
    end;


{****************************************************}
{ UpdateMenus (OVERRIDE)}
{}
{        Perform menu management tasks}
{}
{****************************************************}

    procedure CArtClassApp.UpdateMenus;
    begin
        inherited UpdateMenus;

        gBartender.CheckMarkCmd(gLineSize + cmdLineNone, TRUE);
    end;


{****************************************************}
{ CreateDocument (OVERRIDE)}
{}
{        Make a document in response to the "New" menu selection.}
{}
{****************************************************}

    procedure CArtClassApp.CreateDocument;
        var
            theDocument: CArtClassDoc;

    begin
        new(theDocument);
        theDocument.IArtClassDoc(SELF);
        theDocument.NewFile;
    end;


{****************************************************}
{ OpenDocument (OVERRIDE)}
{}
{        Open an existing file and create a document object for displaying}
{        information.}
{}
{****************************************************}

    procedure CArtClassApp.OpenDocument (macSFReply: SFReply);
        var
            theDocument: CArtClassDoc;

    begin
        new(theDocument);
        theDocument.IArtClassDoc(SELF);
        theDocument.OpenFile(macSFReply);
    end;


{****************************************************}
{ SwitchToDA}
{}
{        A DA is becoming active}
{}
{****************************************************}

    procedure CArtClassApp.SwitchToDA;
    begin
        inherited SwitchToDA;

        gBartender.DisableMenu(MENUtools);
        gBartender.DisableMenu(MENUpatterns);
        gBartender.DisableMenu(MENUlines);
        gBartender.DisableMenu(MENUtext);
    end;


{****************************************************}
{ SwitchFromDA}
{}
{        Our application is becoming active after a DA had been running}
{}
{****************************************************}

    procedure CArtClassApp.SwitchFromDA;
    begin
        inherited SwitchFromDA;

        gBartender.EnableMenu(MENUtools);
        gBartender.EnableMenu(MENUpatterns);
        gBartender.EnableMenu(MENUlines);
        gBartender.EnableMenu(MENUtext);
    end;


{****************************************************}
{ OutOfMemory}
{}
{         A memory request cannot be satisfied. At this point, the rainy day}
{         fund has been liquidated. This method disposes of the about box if }
{        there is one, then calls the inherited method. }
{}
{****************************************************}

    function CArtClassApp.OutOfMemory (bytesNeeded: Size): longint;
        var
            temp: longint;

    begin
        if theAboutBox <> nil then
            theAboutBox.Free;
        temp := inherited OutOfMemory(bytesNeeded);
    end;


end.